home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Periodicals / develop / develop 2 code / Secret Life of Mem. Mgr. / UAboutWindow.p < prev    next >
Encoding:
Text File  |  1990-01-31  |  10.7 KB  |  416 lines  |  [TEXT/MPS ]

  1. unit UAboutWindow;
  2. {$S Main}
  3.  
  4. interface
  5.  
  6.     uses
  7.         Quickdraw, ToolIntf, OSUtils, 
  8.         UGlobals;
  9.  
  10.     const
  11.         AboutRefCon = 1234;
  12.  
  13.     var
  14.         AboutWindow: WindowPtr;
  15.  
  16.     procedure InitAboutWindow;            (* Call during ROM initializations *)
  17.     procedure OpenAboutWindow;            (* Call when the user selects "About..." *)
  18.     function CloseIfAboutWindow (whichWindow: WindowPtr): Boolean; (* Call if the user wants to close a window. *)
  19.                                                                                 (* Returns TRUE if the window was closed *)
  20.  
  21.     function AboutEventProc (theEvent: EventRecord): Boolean;            (* Call each time through your main event loop. *)
  22.                                                                                 (* Returns TRUE if the result was handled for you *)
  23.  
  24. implementation
  25.  
  26.     const
  27.         kAboutWindowID = 2000;
  28.         vScrollRef = 1;
  29.         findButtonRef = 2;
  30.         LineSize = 9;   (* The font size of the about window *)
  31.         LineSpacing = 13; (* The distance between baselines in the about window *)
  32.  
  33.     var
  34.         AboutTEHandle: TEHandle;
  35.         HasStyledTE: Boolean;
  36.  
  37.    (* Private routines *)
  38.     procedure CalcTextRect (wPtr: WindowPtr; var outlineRect, textRect: Rect);
  39.     begin
  40.         with wPtr^.portRect do
  41.             SetRect(outlineRect, left + 8, top + 8, right - 24, bottom - 8);
  42.         textRect := outlineRect;
  43.         InsetRect(outlineRect, -2, -2);
  44.         with textRect do
  45.             bottom := bottom - ((bottom - top) mod LineSpacing);
  46.     end; (* CalcTextRect *)
  47.  
  48.     procedure UpdateAboutWindow (wPtr: WindowPtr);
  49.         var
  50.             oldPort: GrafPtr;
  51.             outlineRect, textRect: Rect;
  52.  
  53.     begin
  54.         GetPort(oldPort);
  55.         SetPort(wPtr);
  56.         BeginUpdate(wPtr);
  57.         EraseRect(wPtr^.portRect);
  58.         if wPtr = AboutWindow then
  59.             begin
  60.                 CalcTextRect(wPtr, outlineRect, textRect);
  61.                 TEUpdate(wPtr^.visRgn^^.rgnBBox, AboutTEHandle);
  62.                 FrameRect(outlineRect);
  63.             end;
  64.         DrawControls(wPtr);
  65.         EndUpdate(wPtr);
  66.         SetPort(oldPort);
  67.     end; (* UpdateAboutWindow *)
  68.  
  69.  
  70.     procedure ActivateAboutWindow (myEvent: EventRecord);
  71.         var
  72.             wPtr: WindowPtr;
  73.  
  74.     begin
  75.         wPtr := WindowPtr(myEvent.message);
  76. (* DrawGrowIcon(wPtr); *)
  77.         if wPtr = AboutWindow then
  78.             begin
  79.                 if ODD(myEvent.modifiers) then
  80.                     TEActivate(AboutTEHandle)
  81.                 else
  82.                     TEDeactivate(AboutTEHandle);
  83.             end;
  84.         if ODD(myEvent.modifiers) then
  85.             SetPort(wPtr);
  86.     end; (* ActivateAboutWindow *)
  87.  
  88.     procedure ScrollDisplay (whichWindow: WindowPtr; vScroll: ControlHandle);
  89.         var
  90.             oldValue, newValue, delta: INTEGER;
  91.  
  92.     begin
  93.         newValue := GetCtlValue(vScroll) * LineSpacing;
  94.         with AboutTEHandle^^ do
  95.             oldValue := viewRect.top - destRect.top;
  96.         delta := oldValue - newValue;
  97.         TEScroll(0, delta, AboutTEHandle);
  98.     end; (* ScrollDisplay *)
  99.  
  100.  
  101.     procedure ScrollActionProc (whichControl: ControlHandle; partCode: INTEGER);
  102.         const
  103.             delay = 0;
  104.  
  105.         var
  106.             ok: Boolean;
  107.             min, max, value, delta: INTEGER;
  108.             oldTime: LONGINT;
  109.             outlineRect, textRect: Rect;
  110.             visLines: INTEGER;
  111.  
  112.     begin
  113.         CalcTextRect(FrontWindow, outlineRect, textRect);
  114.         with textRect do
  115.             visLines := (bottom - top) div LineSpacing;
  116.  
  117.         max := GetCtlMax(whichControl);
  118.         min := GetCtlMin(whichControl);
  119.         ok := TRUE;
  120.         oldTime := TickCount;
  121.         case partCode of
  122.             inUpButton: 
  123.                 delta := -1;
  124.             inDownButton: 
  125.                 delta := 1;
  126.             inPageUp: 
  127.                 delta := -visLines;
  128.             inPageDown: 
  129.                 delta := visLines;
  130.             otherwise
  131.                 ok := FALSE;
  132.         end;
  133.         if ok then
  134.             begin
  135.                 value := GetCtlValue(whichControl);
  136.                 if not ((value = min) and (delta < 0)) or ((value = max) and (delta > 0)) then
  137.                     SetCtlValue(whichControl, value + delta);
  138.  
  139.                 ScrollDisplay(FrontWindow, whichControl);
  140.             end;
  141.  
  142.      (* Set an upper limit on the speed of the control tracking *)
  143.         while (TickCount < (oldTime + delay)) do
  144.             ;
  145.     end; (* ScrollActionProc *)
  146.  
  147.  
  148.     procedure DoMouseInAbout (myEvent: EventRecord);
  149.         var
  150.             globalPt, localPt: Point;
  151.             outlineRect, textRect: Rect;
  152.             partCode: INTEGER;
  153.             whichControl: ControlHandle;
  154.  
  155.     begin
  156.         globalPt := myEvent.where;
  157.         if AboutWindow <> FrontWindow then
  158.             SelectWindow(AboutWindow)
  159.         else
  160.             begin
  161.                 SetPort(AboutWindow);
  162.                 localPt := GlobalPt;
  163.                 GlobalToLocal(localPt);
  164.                 CalcTextRect(AboutWindow, outlineRect, textRect);
  165.                 if PtInRect(localPt, textRect) then
  166. (* TEClick(localPt, BitAnd(myEvent.modifiers, shiftKey) <> 0, AboutTEHAndle) *)
  167.                 else
  168.                     begin
  169.                         partCode := FindControl(localPt, AboutWindow, whichControl);
  170.                         case partCode of
  171.                             0: 
  172.                                 ;  (* do nothing *)
  173.                             inUpButton, inDownButton, inPageUp, inPageDown: 
  174.                                 partCode := TrackControl(whichControl, localPt, @ScrollActionProc);
  175.  
  176.                             inThumb: 
  177.                                 begin
  178.                                     partCode := TrackControl(whichControl, localPt, nil);
  179.                                     if (partCode <> 0) then
  180.                                         ScrollDisplay(AboutWindow, whichControl);
  181.                                 end;
  182.  
  183.                         end; (* CASE *)
  184.                     end; (* Check the controls *)
  185.             end; (* We're the frontmost window *)
  186.     end; (* DoMouseInAbout *)
  187.  
  188.    (* Public routines *)
  189.  
  190.     procedure InitAboutWindow;
  191.         const
  192.             TEStylNewTrapNumber = $A83E; { trap number of TEStylNew }
  193.             UnimplementedTrapNumber = $A89F;  {number of "unimplemented trap"}
  194.  
  195.         var
  196.             rom: integer;       (* Which version of the ROM are we running? *)
  197.             machine: integer; (* Which machine is this?? *)
  198.  
  199.     begin
  200.         AboutWindow := nil;
  201.         AboutTEHandle := nil;
  202.         Environs(rom, machine);  (* Make sure that we can call SysEnvirons -- the LSP glue doesn't *)
  203.         if (rom >= 117) then      (* This is a Mac 512Ke or later , so we can see if we have WaitNextEvent *)
  204.             HasStyledTE := NGetTrapAddress(TEStylNewTrapNumber, ToolTrap) <> GetTrapAddress(UnimplementedTrapNumber)
  205.         else
  206.             HasStyledTE := FALSE;
  207.     end; (* InitAboutWindow *)
  208.  
  209.     procedure AdjustAboutWindow;
  210.         var
  211.             newViewRect, bodyFrameRect: Rect;
  212.             vScroll: ControlHandle;
  213.             numLines: INTEGER;
  214.             newMaxValue: INTEGER;
  215.  
  216.     begin
  217.         SetCursor(GetCursor(watchCursor)^^);
  218.         CalcTextRect(AboutWindow, bodyFrameRect, newViewRect);
  219.         SetPort(AboutWindow);
  220.         InvalRect(newViewRect);
  221.         vScroll := WindowPeek(AboutWindow)^.ControlList;
  222.  
  223.         EraseRect(AboutWindow^.portRect);
  224.         with bodyFrameRect do
  225.             begin
  226.                 HideControl(vScroll);
  227.                 MoveControl(vScroll, right - 1, top);
  228.                 SizeControl(vScroll, 16, (bottom - top));
  229.                 ShowControl(vScroll);
  230.                 ValidRect(vScroll^^.contrlRect);
  231.             end;
  232.         FrameRect(bodyFrameRect);
  233.  
  234.         with AboutTEHandle^^ do
  235.             begin
  236.                 destRect := newViewRect;
  237.                 viewRect := newViewRect;
  238.             end;
  239.         TECalText(AboutTEHandle);
  240.         with AboutTEHandle^^ do
  241.             begin
  242.                 numLines := nLines;
  243.                 if (CharsHandle(hText)^^[teLength] = CHR(13)) then
  244.                     numLines := nLines + 1;
  245.             end;
  246.  
  247.         with newViewRect do
  248.             begin
  249.                 newMaxValue := ((numLines * LineSpacing) - (bottom - top)) div LineSpacing;
  250.                 if newMaxValue < 0 then
  251.                     newMaxValue := 0;
  252.                 SetCtlMax(vScroll, newMaxValue);
  253.             end;
  254.         InitCursor;
  255.     end; (* AdjustAboutWindow *)
  256.  
  257.  
  258.     procedure OpenAboutWindow;
  259.  
  260.         procedure GetAboutWindowText;
  261.             var
  262.                 scratchRect: Rect;
  263.                 tHandle: Handle;
  264.                 scratchControl: ControlHandle;
  265.  
  266.         begin
  267.             SetRect(scratchRect, 0, 0, 10, 10);
  268.             TextFont(geneva);
  269.             TextFace([]);
  270.             TextSize(LineSize);
  271.             if HasStyledTE then
  272.                 AboutTEHandle := TEStylNew(scratchRect, scratchRect)
  273.             else
  274.                 AboutTEHandle := TENew(scratchRect, scratchRect);
  275.             tHandle := GetNamedResource('TEXT', 'About');
  276.             if (THandle <> nil) then
  277.                 begin
  278.                     HLock(THandle);
  279.                     if HasStyledTE then
  280.                         TEStylInsert(THandle^, GetHandleSize(THandle), stScrpHandle(GetNamedResource('styl', 'About')), AboutTEHandle)
  281.                     else
  282.                         TESetText(THandle^, GetHandleSize(THandle), AboutTEHandle);
  283.                     TESetSelect(0, 0, AboutTEHandle);
  284.                     ReleaseResource(THandle);
  285.              (* Add the controls *)
  286.                     SetWRefCon(AboutWindow, AboutRefCon);
  287.                     scratchControl := NewControl(AboutWindow, scratchRect, '', TRUE, 0, 0, 0, 16, vScrollRef);
  288.  
  289.                     AdjustAboutWindow;
  290.                     ShowWindow(AboutWindow);
  291.                 end
  292.             else
  293.                 begin
  294.                     DisposeWindow(AboutWindow);
  295.                     TEDispose(AboutTEHandle);
  296.                     AboutWindow := nil;
  297.                 end;
  298.         end; (* GetAboutWindowText *)
  299.  
  300.     begin
  301.         if (AboutWindow <> nil) then
  302.             SelectWindow(AboutWindow)
  303.         else
  304.             begin
  305.                 AboutWindow := GetNewWindow(kAboutWindowID, nil, WindowPtr(-1));
  306.                 if (AboutWindow <> nil) then
  307.                     begin
  308.                         SetPort(AboutWindow);
  309.                         GetAboutWindowText;
  310.                     end;
  311.             end;
  312.     end; (* OpenAboutWindow *)
  313.  
  314.     function CloseIfAboutWindow (whichWindow: WindowPtr): Boolean;
  315.     begin
  316.         if (whichWindow = AboutWindow) and (AboutWindow <> nil) then
  317.             begin
  318.                 HideWindow(AboutWindow);
  319.                 TEDispose(AboutTEHandle);
  320.                 AboutTEHandle := nil;
  321.                 DisposeControl(WindowPeek(AboutWindow)^.ControlList);
  322.                 DisposeWindow(AboutWindow);
  323.                 AboutWindow := nil;
  324.                 CloseIfAboutWindow := TRUE;
  325.             end
  326.         else
  327.             CloseIfAboutWindow := FALSE;
  328.     end; (* CloseAboutWindow *)
  329.  
  330.  
  331.     function AboutEventProc (theEvent: EventRecord): Boolean;
  332.    (* This returns TRUE if it handled the event, FALSE otherwise *)
  333.    (* (It handles Null events (returning FALSE so you can take some time), Update, Activate, *)
  334.    (*  MouseDowns in Content, Grow, Zoom, and GoAway -- returning TRUE. You have to handle *)
  335.    (* everything else (i.e. write a standard main event loop) *)
  336.  
  337.         var
  338.             result: Boolean;
  339.             location: INTEGER;
  340.             whichWindow: WindowPtr;
  341.             sizeLimits: Rect;
  342.             newSize: LONGINT;
  343.  
  344.     begin
  345.         result := FALSE;
  346.         if (AboutWindow <> nil) then
  347.             case theEvent.what of
  348.                 nullEvent: 
  349.                     if (FrontWindow = AboutWindow) then
  350.                         TEIdle(AboutTEHandle);
  351.               (* result := FALSE *)
  352.  
  353.                 mouseDown: 
  354.                     begin
  355.                         location := FindWindow(theEvent.where, whichWindow);
  356.                         if (whichWindow = AboutWindow) then
  357.                             case location of
  358.                                 inContent: 
  359.                                     begin
  360.                                         DoMouseInAbout(theEvent);
  361.                                         result := TRUE;
  362.                                     end;
  363.  
  364.                                 inGoAway: 
  365.                                     if TrackGoAway(AboutWindow, theEvent.where) then
  366.                                         begin
  367.                                             result := CloseIfAboutWindow(whichWindow);
  368.                                         end;
  369.  
  370.                                 inGrow: 
  371.                                     begin
  372.                                         sizeLimits := ScreenBits.bounds;
  373.                                         InsetRect(sizeLimits, 32, 32);
  374.                                         newSize := GrowWindow(AboutWindow, theEvent.where, sizeLimits);
  375.                                         if (newSize <> 0) then
  376.                                             begin
  377.                                                 SizeWindow(AboutWindow, LoWord(newSize), HiWord(newSize), FALSE);
  378.                                                 InvalRect(AboutWindow^.portRect);
  379.                                                 AdjustAboutWindow;
  380.                                                 UpdateAboutWindow(AboutWindow);
  381.                                                 result := TRUE;
  382.                                             end;
  383.                                     end;
  384.  
  385.                                 inZoomIn, inZoomOut: 
  386.                                     if TrackBox(AboutWindow, theEvent.where, location) then
  387.                                         begin
  388.                                             ZoomWindow(AboutWindow, location, FALSE);
  389.                                             InvalRect(AboutWindow^.portRect);
  390.                                             AdjustAboutWindow;
  391.                                             UpdateAboutWindow(AboutWindow);
  392.                                             result := TRUE;
  393.                                         end;
  394.  
  395.                             end; (* IF ... / CASE location OF *)
  396.                     end; (* CASE mouseDown *)
  397.  
  398.                 UpdateEvt: 
  399.                     if (WindowPtr(theEvent.message) = AboutWindow) then
  400.                         begin
  401.                             UpdateAboutWindow(AboutWindow);
  402.                             result := TRUE;
  403.                         end; (* IF *)
  404.  
  405.                 ActivateEvt: 
  406.                     if (WindowPtr(theEvent.message) = AboutWindow) then
  407.                         begin
  408.                             ActivateAboutWindow(theEvent);
  409.                             result := TRUE;
  410.                         end; (* IF *)
  411.  
  412.             end; (* CASE *)
  413.         AboutEventProc := result;
  414.     end; (* AboutEventProc *)
  415.  
  416. end.